home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 18 / fpc103.zip / DEFERS.SEQ < prev    next >
Text File  |  1988-06-20  |  1KB  |  44 lines
  1. \ DEFERS.SEQ    Adds the ability to make a defered word chain. Tom Zimmer
  2.  
  3. comment:
  4.  
  5.   The words which follow, give you the ability to make a chain of procedures
  6. that will be performed in sequence when a normal DEFERed word is executed.
  7.  
  8.   DEFERS chains in the current contents of the specified defered word.  The
  9. new definition is then installed into the defered word with IS.
  10.  
  11.         DEFER JUNK      ' NOOP IS JUNK
  12.  
  13.         : JUNK1         DEFERS JUNK .. MYJUNK1 .. ;
  14.  
  15.         ' JUNK1 IS JUNK
  16.  
  17.         : JUNK2         DEFERS JUNK .. MYJUNK2 .. ;
  18.  
  19.         ' JUNK2 IS JUNK
  20.  
  21.   When JUNK is executed, the word NOOP will be performed, then MYJUNK1,
  22. followed by MYJUNK2.
  23.  
  24.   UNDEFER can be used to remove entries from the chain, but must be used
  25. on the word defined later than the word you want to remove:
  26.  
  27.         UNDEFER JUNK2 <enter>
  28.  
  29.   The above command removes JUNK1 from the chain.
  30.  
  31. comment;
  32.  
  33. : DEFERS        ( T1 -- )
  34.                 ' DUP @REL>ABS [ ' KEY @REL>ABS ] LITERAL = >R
  35.                 >BODY @ R> IF UP @ + @ THEN X, ; IMMEDIATE
  36.  
  37. : UNDEFER       ( T1 -- )
  38.                 ' DUP @REL>ABS [ ' KEY @REL>ABS ] LITERAL = >R
  39.                 >BODY R> IF @ UP @ + THEN DUP @
  40.                 DUP @REL>ABS [ ' DEFERS @REL>ABS ] LITERAL <>
  41.                 ABORT" Can only UNDEFER through a : (colon) definition."
  42.                 >BODY @ XSEG @ + 0 @L SWAP ! ;
  43.  
  44.